home *** CD-ROM | disk | FTP | other *** search
/ Aminet 2 / Aminet AMIGA CDROM (1994)(Walnut Creek)[Feb 1994][W.O. 44790-1].iso / Aminet / util / gnu / GNU_TILE_FORTH.lha / src / multi-tasking.v < prev    next >
Text File  |  1992-05-19  |  6KB  |  237 lines
  1. /*
  2.   C BASED FORTH-83 MULTI-TASKING KERNEL: MULTI-TASKING EXTENSIONS
  3.  
  4.   Copyright (C) 1988-1990 by Mikael R.K. Patel
  5.  
  6.   Computer Aided Design Laboratory (CADLAB)
  7.   Department of Computer and Information Science
  8.   Linkoping University
  9.   S-581 83 LINKOPING
  10.   SWEDEN
  11.  
  12.   Email: mip@ida.liu.se
  13.  
  14.   Started on: 30 June 1988
  15.  
  16.   Last updated on: 20 April 1990
  17.  
  18.   Dependencies:
  19.     (cc) kernel.c, kernel.h
  20.  
  21.   Description:
  22.     Multi-tasking kernel extension vocabulary.
  23.  
  24.   Copying:
  25.        This program is free software; you can redistribute it and/or modify
  26.        it under the terms of the GNU General Public License as published by
  27.        the Free Software Foundation; either version 1, or (at your option)
  28.        any later version.
  29.  
  30.        This program is distributed in the hope that it will be useful,
  31.        but WITHOUT ANY WARRANTY; without even the implied warranty of
  32.        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  33.        GNU General Public License for more details.
  34.  
  35.        You should have received a copy of the GNU General Public License
  36.        along with this program; see the file COPYING.  If not, write to
  37.        the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 
  38.  
  39. */
  40.  
  41. static ENTRY toterminate = (ENTRY) &terminate;
  42.  
  43. NORMAL_CONSTANT(foreground_entry, forth, "foreground", (INT32) &foreground);
  44.  
  45. NORMAL_CONSTANT(running_entry, foreground_entry, "running", (INT32) &tp);
  46.  
  47. VOID douser()
  48. {
  49.     spush(NORMAL, INT32);
  50.     spush(USER, INT32);
  51.     spush(' ', INT32);
  52.     doword();
  53.     doentry();
  54. }
  55.  
  56. NORMAL_CODE(user, running_entry, "user", douser);
  57.  
  58. TASK make_task(users, params, returns, action)
  59.     INT32 users, params, returns, action;
  60. {
  61.     INT32 size;
  62.     TASK t;
  63.  
  64.     /* Calculate size of task and allocate */
  65.     size = sizeof(task_header) + users + (params + returns) * sizeof(INT32);
  66.     t = (TASK) malloc((unsigned) size);
  67.  
  68.     /* Initiate queues structure, status and environment */
  69.     t -> queue.succ = t -> queue.pred = (QUEUE) t;
  70.     t -> status = READY;
  71.  
  72.     t -> s0 = t -> sp = (PTR32) ((PTR8) t + size - returns * sizeof(INT32));
  73.     t -> r0 = t -> rp = (PTR32) ((PTR8) t + size);
  74.     t -> ip = (action ? (PTR32) action : (PTR32) &toterminate);
  75.     t -> fp = NIL;
  76.     t -> ep = NIL;
  77.  
  78.     /* Return task pointer */
  79.     return t;
  80. }
  81.  
  82. VOID dotask()
  83. {
  84.     INT32 users, params, returns, action;
  85.  
  86.     action  = spop(INT32);
  87.     returns = spop(INT32);
  88.     params  = spop(INT32);
  89.     users   = spop(INT32);
  90.     spush(make_task(users, params, returns, action), TASK);
  91. }
  92.  
  93. NORMAL_CODE(task_entry, user, "task", dotask);
  94.  
  95. VOID dofork()
  96. {
  97.     TASK t;
  98.     INT32 size;
  99.  
  100.     register INT32 n;
  101.     register PTR8 to;
  102.     register PTR8 from;
  103.  
  104.  
  105.     /* Allocate memory for the new task */
  106.     size = ((PTR8) r0) - ((PTR8) tp);
  107.     t = (TASK) malloc((unsigned) size);
  108.     
  109.     /* Push top of stack for clean state */
  110.     sdrop();
  111.  
  112.     /* Copy the current task */
  113.     n = size;
  114.     to = (PTR8) t;
  115.     from = (PTR8) tp;
  116.     while (--n != -1) *to++ = *from++;
  117.  
  118.     /* Assign the new fields */
  119.     t -> s0 = (PTR32) ((INT32) ((PTR8) t) + ((PTR8) s0) - ((PTR8) tp));
  120.     t -> sp = (PTR32) ((INT32) ((PTR8) t) + ((PTR8) sp) - ((PTR8) tp));
  121.     t -> ip = ip;
  122.     t -> r0 = (PTR32) ((INT32) ((PTR8) t) + ((PTR8) r0) - ((PTR8) tp));
  123.     t -> rp = (PTR32) ((INT32) ((PTR8) t) + ((PTR8) rp) - ((PTR8) tp));
  124.     t -> fp = (fp ? (PTR32) ((INT32) ((PTR8) t) + ((PTR8) fp) - ((PTR8) tp)) : NIL);
  125.     t -> ep = (ep ? (PTR32) ((INT32) ((PTR8) t) + ((PTR8) ep) - ((PTR8) tp)) : NIL);
  126.     
  127.     /* Pop back top of stack */
  128.     sdup();
  129.  
  130.     /* Push pointer to child task as result to parent task */
  131.     spush(t, TASK);
  132.     
  133.     /* Schedule the child task and push parent */
  134.     spush(t, TASK);
  135.     t = tp;
  136.     doschedule();
  137.  
  138.     /* Push pointer to parent task as result to child task */
  139.     tos.TASK = t;
  140. }
  141.  
  142. NORMAL_CODE(fork_entry, task_entry, "fork", dofork);
  143.  
  144. VOID doresume()
  145. {
  146.     TASK t;
  147.  
  148.     t = tos.TASK;
  149.  
  150.     /* Check if the task to resume is the current task and active */
  151.     if (t -> status && t != tp) {
  152.  
  153.     /* Store the state of the current task */
  154.     tp -> sp = (PTR32) sp;
  155.     tp -> s0 = (PTR32) s0;
  156.     tp -> ip = ip;
  157.     tp -> rp = rp;
  158.     tp -> r0 = r0;
  159.     tp -> fp = fp;
  160.     tp -> ep = ep;
  161.  
  162.     /* Indicate task switch to the virtual machine */
  163.     running = FALSE;
  164.     
  165.     /* Restore the parameter task */
  166.     sp = (PTR) t -> sp;
  167.     s0 = (PTR) t -> s0;
  168.     ip = t -> ip;
  169.     rp = t -> rp;
  170.     r0 = t -> r0;
  171.     fp = t -> fp;
  172.     ep = t -> ep;
  173.     tp = t;
  174.     }
  175.  
  176.     /* Load top of stack again */
  177.    sdrop();
  178. }
  179.  
  180. NORMAL_CODE(resume, fork_entry, "resume", doresume);
  181.  
  182. VOID doschedule()
  183. {
  184.     /* Put the task after the current task */
  185.     spush(tp -> queue.succ, QUEUE);
  186.     doenqueue();
  187.  
  188.     /* Resume the task now */
  189.     dodetach();
  190.  
  191.     /* Restore parameter and return stack */
  192.     spush(tp, TASK);
  193.     rpush(&toterminate);
  194.  
  195.     /* Mark the task as running */
  196.     tp -> status = RUNNING;
  197. }
  198.  
  199. NORMAL_CODE(schedule, resume, "schedule", doschedule);
  200.  
  201. VOID dodetach()
  202. {
  203.     /* Resume the next task in the system task queue */
  204.     spush(tp -> queue.succ, QUEUE);
  205.     doresume();
  206. }
  207.  
  208. NORMAL_CODE(detach, schedule , "detach", dodetach);
  209.  
  210. VOID doterminate()
  211. {
  212.     TASK t = tp;
  213.  
  214.     /* Check if the task is the foreground task */
  215.     if (tp == foreground) {
  216.  
  217.     /* Empty the return stack and signal end of execution to inner loop */
  218.     rinit();
  219.     running = FALSE;
  220.     tasking = FALSE;
  221.  
  222.     /* Foreground should always terminate on last exit */
  223.     ip = (PTR32) &toterminate;
  224.     }
  225.     else {
  226.  
  227.     /* else remove the current task from the system task queue */
  228.     dodetach();
  229.     t -> status = TERMINATED;
  230.     spush(t, TASK);
  231.     dodequeue();
  232.     }
  233. }
  234.  
  235. NORMAL_CODE(terminate, detach, "terminate", doterminate);
  236.  
  237.